home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / oop.swg / 0036_ScreenSaver Object.pas < prev    next >
Pascal/Delphi Source File  |  1994-02-15  |  4KB  |  178 lines
  1. UNIT ScrSaver;
  2.  
  3. {
  4.   ScreenSaver Object based on the ScreenSaver by
  5.   Stefan Boether in the TurboVision Forum of CompuServe
  6.  
  7.   (C) M.Fiel 1993 Vienna - Austria
  8.   CompuServe ID : 100041,2007
  9.  
  10.   Initialize it with a string (wich is printed on the screen) and the time
  11.   in seconds when it should start.
  12.  
  13.   To see how it works start the menupoint 'ScreenSave' in the
  14.   demo.exe
  15.  
  16.   to see how to initialisze the saver watch the demo source.
  17.  
  18.   to increase or decrease the speed of the printed string use the
  19.   '+' and '-' key (the gray ones);
  20.  
  21.   Use freely if you find it useful.
  22.  
  23. }
  24.  
  25.  
  26. INTERFACE
  27.  
  28. USES  Dos, Objects, Drivers, Views, App ;
  29.  
  30. TYPE
  31.  
  32.   PScreenSaver = ^TScreenSaver;
  33.   TScreenSaver = object( TView )
  34.  
  35.     Activ       : Boolean;
  36.     Seconds     : Integer;
  37.  
  38.     constructor Init(FName:String;StartSeconds:Integer);
  39.     procedure   GetEvent(var Event : TEvent); virtual;
  40.     function    itsTimeToAct : Boolean;
  41.  
  42.     PRIVATE
  43.  
  44.     LastPos     : Integer;
  45.     Factory     : PString;
  46.     DelayTime   : Integer;
  47.     IdleTime    : LongInt;
  48.  
  49.     procedure   Action; virtual;
  50.     procedure   SetIdleTime; virtual;
  51.  
  52.   END;
  53.  
  54. IMPLEMENTATION
  55.  
  56.   USES
  57.     Crt;
  58.  
  59.   constructor TScreenSaver.Init(FName:String;StartSeconds:Integer);
  60.     var
  61.       R : TRect;
  62.     begin
  63.  
  64.       R.Assign(ScreenWidth-1,0,ScreenWidth,1);
  65.       inherited Init(R);
  66.  
  67.       LastPos:=(ScreenWidth DIV 2);
  68.       Factory:=NewStr(FName);
  69.       DelayTime:=100;
  70.       Seconds :=StartSeconds;
  71.       SetIdleTime;
  72.  
  73.     end;
  74.  
  75.   procedure TScreenSaver.GetEvent(var Event:TEvent);
  76.     begin
  77.  
  78.       if (Event.What=evNothing) then begin
  79.  
  80.         if not Activ then begin
  81.  
  82.           if itsTimeToAct then begin
  83.             Activ := True;
  84.             DoneVideo;
  85.           end;
  86.  
  87.         end else Action;
  88.  
  89.       end else if Activ then begin
  90.  
  91.         if ((Event.What=evKeyDown) and ((Event.KeyCode=kbGrayPlus) or
  92.                                         (Event.KeyCode=kbGrayMinus)) ) then begin
  93.           case Event.KeyCode of
  94.             kbGrayPlus:if DelayTime>0 then dec(DelayTime);
  95.             kbGrayMinus:if DelayTime<4000 then inc(DelayTime);
  96.           end;
  97.  
  98.           ClearEvent(Event);
  99.  
  100.         end else begin
  101.           Activ := False;
  102.           InitVideo;
  103.           Application^.ReDraw;
  104.           SetIdleTime;
  105.         end;
  106.       end else
  107.         SetIdleTime;
  108.     end;
  109.  
  110.   procedure TScreenSaver.SetIdleTime;
  111.     var
  112.       h,m,s,mm: word;
  113.     begin
  114.       GetTime(h,m,s,mm);
  115.       IdleTime:=(h*3600)+(m*60)+s;
  116.     end;
  117.  
  118.   function TScreenSaver.itsTimeToAct : Boolean;
  119.     var
  120.       h,m,s,mm: word;
  121.     begin
  122.       GetTime(h,m,s,mm);
  123.       itsTimeToAct:=( ((h*3600)+(m*60)+s) > (IdleTime+Seconds) )
  124.     end;
  125.  
  126.   procedure TScreenSaver.Action;
  127.     var
  128.       Reg:Registers;
  129.       PrStr : String;
  130.     begin
  131.       Dec(LastPos);
  132.  
  133.       if LastPos>0 then begin
  134.  
  135.        if LastPos<=ScreenWidth then begin
  136.          if LastPos=ScreenWidth then LastPos:=ScreenWidth-length(Factory^);
  137.          Reg.DL:=LastPos;
  138.          PrStr:=Factory^+' ';
  139.        end else begin
  140.          PrStr:=(Copy(Factory^,1,ScreenWidth+length(Factory^)-LastPos));
  141.          Reg.DL:=ScreenWidth-length(PrStr);
  142.        end;
  143.  
  144.      end else begin
  145.  
  146.        if length(Factory^)+LastPos=0 then begin
  147.          PrStr:=' ';
  148.          Reg.DL:=0;
  149.          LastPos:=ScreenWidth+length(Factory^);
  150.        end else begin
  151.          Reg.DL := $00;
  152.          PrStr:=Copy(Factory^,Abs(LastPos)+1,80)+' ';
  153.        end;
  154.  
  155.      end;
  156.  
  157.      with Reg do begin
  158.        AH := $02;
  159.        BH := $00;
  160.        DH := (ScreenHeight DIV 2) + (ScreenHeight DIV 4);
  161.      end;
  162.      Intr($10,Reg); (* Set Cursor Position *)
  163.  
  164.      PrintStr(PrStr);
  165.  
  166.      with Reg do begin
  167.        AH:=$02;
  168.        BH:=$00;
  169.        DH:=(ScreenHeight+1);
  170.        DL:=$00;
  171.      end;
  172.      Intr($10,Reg); (* Set Cursor Position outside -> Cursor not visible *)
  173.  
  174.      Delay(DelayTime);
  175.  
  176.    end;
  177.  
  178. END.